home *** CD-ROM | disk | FTP | other *** search
/ MacWorld UK 2000 March / MW_UK_2000_03.iso / Shareware World / Utilities / Text Processing / Alpha / Tcl / SystemCode / textFill.tcl < prev    next >
Encoding:
Text File  |  1999-10-29  |  7.0 KB  |  244 lines  |  [TEXT/ALFA]
  1. ####################################################################
  2. # 
  3. # Much by Vince Darley.
  4. # 
  5. #                                    created: 26/11/96 {7:08:34 pm} 
  6. #                                last update: 10/29/1999 {14:31:28 PM}
  7. #  Author: Vince Darley
  8. #  E-mail: <vince@santafe.edu>
  9. #    mail: 317 Paseo de Peralta, Santa Fe, NM 87501, USA
  10. #     www: <http://www.santafe.edu/~vince/>
  11. #  
  12. ####################################################################
  13.  
  14. ## 
  15.  #       
  16.  # 'rememberWhereYouAre'
  17.  # 
  18.  #  Given the start of a paragraph and the point to remember, this returns a
  19.  #  record which must be passed to the following function so that it can
  20.  #  find the spot later, even after the paragraph has had
  21.  #  space/tabs/new-lines meddled with.  An optional last argument is a list
  22.  #  of other characters quoted so they are regexp insensitive, which should
  23.  #  also be ignored.  This is used so we can remember positions in text
  24.  #  which has cosmetic characters on the left/right which are not wrapped
  25.  #  (such as the hashes to the left here!).
  26.  #       
  27.  # 'goBackToWhereYouWere'
  28.  # 
  29.  #  Given the beginning and end of a selection, and a previous record, where
  30.  #  the beginning, and record correspond to a previous call of
  31.  #  'rememberWhereYouAre', this procedure will move the insertion point to
  32.  #  the correct place.
  33.  #       
  34.  ##
  35.  
  36. proc rememberWhereYouAre {startPara pos endPara {commentReg ""}} {
  37.     set start [pos::math $pos -20]
  38.     if {[pos::compare $start < $startPara]} {
  39.     set start $startPara
  40.     }
  41.     set __g_remember_str [getText $start $pos]
  42.     if {[string length [string trim $__g_remember_str]] < 3} {
  43.     # there wasn't much to remember; try the other way
  44.     set end [pos::math $pos +20]
  45.     if {[pos::compare $end > $endPara]} {
  46.         set end $endPara
  47.     }
  48.     set __g_remember_str [getText $pos $end]
  49.     set __g_remember_dir 0
  50.     } else {
  51.     set __g_remember_dir 1
  52.     }
  53.     
  54.     set __g_remember_str [quote::Regfind $__g_remember_str]
  55.     regsub -all "\[ \t\r\n${commentReg}\]+" $__g_remember_str \
  56.       {[ \t\r\n${commentReg}]+} __g_remember_str
  57.     return [list $__g_remember_str $__g_remember_dir]
  58. }
  59.  
  60. proc goBackToWhereYouWere {start end memory} {
  61.     if {[lindex $memory 0] != "" } {
  62.     regexp -indices ".*([lindex $memory 0]).*" [getText $start $end] \
  63.       "" submatch
  64.     if {[info exists submatch]} {
  65.         set p [pos::math $start + [lindex $memory 1] + \
  66.           [lindex $submatch [lindex $memory 1]]]
  67.     } else {
  68.         set p $end
  69.     }
  70.     goto [expr {[pos::compare $p >= $end] ? [pos::math $end - 1] : $p}]
  71.     } else {
  72.     goto $start
  73.     }
  74. }
  75.  
  76. ## 
  77.  # -------------------------------------------------------------------------
  78.  #     
  79.  #    "getLeadingIndent" --
  80.  #    
  81.  #  Find the indentation of the line containing 'pos', and convert it to a
  82.  #  minimal form of tabs followed by spaces.  If 'size' is given, then the
  83.  #  variable of that name is set to the length of the indent.  Similarly
  84.  #  'halftab' can be set to half a tab. 
  85.  # -------------------------------------------------------------------------
  86.  ##
  87. proc getLeadingIndent { pos {size ""} {halftab ""} } {
  88.     # get the leading whitespace of the current line
  89.     set res [search -s -n -f 1 -r 1 "^\[ \t\]*" [lineStart $pos]]
  90.     
  91.     # convert it to minimal form: tabs then spaces, stored in 'front'
  92.     getWinInfo a
  93.     set sp [string range "              " 1 $a(tabsize) ]
  94.     regsub -all "($sp| +\t)" [eval getText $res] "\t" front
  95.     if { $size != "" } {
  96.     upvar $size ind
  97.     # get the length of the indent
  98.     regsub -all "\t" $front $sp lfront
  99.     set ind [string length $lfront]
  100.     }
  101.     if { $halftab != "" } {
  102.     upvar $halftab ht
  103.     # get the length of half a tab
  104.     set ht [string range "            " 1 [expr {$a(tabsize)/2}]]
  105.     }
  106.     
  107.     return $front
  108. }
  109.  
  110.  
  111. proc getEndpts {} {
  112.     if {[pos::compare [getPos] == [selEnd]]} {
  113.     set start [getPos]
  114.     set finish [getMark]
  115.     if {[pos::compare $start > $finish]} {
  116.         set temp $start
  117.         set start $finish
  118.         set finish $temp
  119.     }
  120.     } else {
  121.     set start [getPos]
  122.     set finish [selEnd]
  123.     }
  124.     return [list $start $finish]
  125. }
  126.  
  127.  
  128. proc fillRegion {} {
  129.     global leftFillColumn
  130.     set ends [getEndpts]
  131.     set start [lineStart [lindex $ends 0]]
  132.     set finish [lindex $ends 1]
  133.     goto $start
  134.     set text [fillText $start $finish]
  135.     replaceText $start $finish [format "%$leftFillColumn\s" ""] $text "\r"
  136. }
  137.     
  138. proc wrapParagraph {} {
  139.     set pos [getPos]
  140.     set start [paragraph::start $pos] 
  141.     set finish [paragraph::finish $pos]
  142.     goto $start
  143.     wrapText $start $finish
  144.     goto $pos
  145. }
  146.  
  147. proc wrapRegion {} {
  148.     set ends [getEndpts]
  149.     set start [lineStart [lindex $ends 0]]
  150.     set finish [lindex $ends 1]
  151.     if {[pos::compare $start == $finish]} {
  152.     set finish [maxPos]
  153.     }
  154.     wrapText $start $finish
  155. }
  156.     
  157.  
  158.  
  159. # Remove text from window, transform, and insert back into window.
  160. proc fillText {from to} {
  161.     global doubleSpaces
  162.     set text [getText $from $to]
  163.     regexp "^\[ \t\]*" $text front
  164.     regsub -all "\[ \t\n\r\]+" [string trim $text] " " text
  165.     if {$doubleSpaces} {regsub -all {(([^.][a-z]|[^a-zA-Z@]|\\@)[.?!]("|'|'')?([])])?) } $text {\1  } text}
  166.     regsub -all " ?\[\r\n\]" [string trimright [breakIntoLines $text]] "\r${front}" text
  167.     return $front$text
  168. }
  169.  
  170. proc paragraphToLine {} {
  171.     global fillColumn
  172.     global leftFillColumn
  173.     set fc $fillColumn
  174.     set lc $leftFillColumn
  175.     set fillColumn 10000
  176.     set leftFillColumn 0
  177.     fillRegion
  178.     set fillColumn $fc
  179.     set leftFillColumn $lc
  180. }
  181.  
  182. proc lineToParagraph {} {
  183.     global fillColumn
  184.     global leftFillColumn
  185.     set fc $fillColumn
  186.     set fillColumn 75
  187.     set lc $leftFillColumn
  188.     set leftFillColumn 0
  189.     fillRegion
  190.     set fillColumn $fc
  191.     set leftFillColumn $lc
  192. }
  193.  
  194.  
  195. #set sentEnd {[.!?](\r|\n| +)}
  196. set sentEnd {(\r\r|\n\n|[.!?](\r|\n| +))}
  197. set sentBeg {[\r\n ][A-Z]}
  198.  
  199. proc nextSentence {} {
  200.     global sentBeg sentEnd
  201.     if {![catch {search -s -f 1 -r 1 $sentEnd [getPos]} mtch]} {
  202.     if {![catch {search -s -f 1 -r 1 -i 0 $sentBeg [pos::math [lindex $mtch 1] - 1]} mtch]} {
  203.         goto [pos::math [lindex $mtch 0] + 1]
  204.     }
  205.     }
  206. }
  207.  
  208.  
  209. proc prevSentence {} {
  210.     global sentBeg sentEnd
  211.     if {[catch {search -s -f 0 -r 1 $sentBeg [pos::math [getPos] - 2]} mtch]} return
  212.     if {![catch {search -s -f 0 -r 1 $sentEnd [lindex $mtch 1]} mtch]} {
  213.     if {![catch {search -s -f 1 -r 1 -i 0 $sentBeg [pos::math [lindex $mtch 1] - 1]} mtch]} {
  214.         goto [pos::math [lindex $mtch 0] + 1]
  215.     }
  216.     }
  217. }
  218.  
  219. #===============================================================================
  220. # Called by Alpha to do "soft wrapping"
  221. proc softProc {pos start next} {
  222.     global leftFillColumn
  223.     goto $start
  224.     set finish [paraFinish $start]
  225.     set text [fillText $start $finish]
  226.     if {"${text}\r" != [getText $start $finish]} {
  227.     replaceText $start $finish [format "%$leftFillColumn\s" ""] $text "\r"
  228.     return 1
  229.     } else {
  230.     return 0
  231.     }
  232. }
  233.  
  234. proc dividingLine {} {
  235.     global mode
  236.     global ${mode}modeVars
  237.     if {[info exists ${mode}modeVars(prefixString)]} {
  238.     set a [string trim [set ${mode}modeVars(prefixString)]]
  239.     } else {
  240.     set a "#"
  241.     }
  242.     insertText "${a}===============================================================================\r"
  243. }
  244.